home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / dviware / ln03 / rmcs / ginotosix.for < prev    next >
Text File  |  1989-06-06  |  4KB  |  160 lines
  1.      IMPLICIT NONE
  2. C 
  3. C PROGRAM DESCRIPTION: 
  4. C 
  5. C     Converts a GINO SAVDRA file into a sixel file suitable for importing
  6. C     into TeX via the /special{SX filename} command
  7. C 
  8. C AUTHORS: 
  9. C 
  10. C     Sqn Ldr J P Baggott MBE MA CEng MIEE RAF
  11. C 
  12. C CREATION DATE:     1 Dec 88
  13. C 
  14. C 
  15. C         C H A N G E   L O G
  16. C 
  17. C     Date     | Name  | Description
  18. C ----------------+-------+-----------------------------------------------------
  19. C
  20. C
  21. C
  22.     CHARACTER*4096    LINE        !Line buffer
  23.     INTEGER*4    COUNT        !Number of chars in line
  24.     INTEGER*4    START        !Start of outpur line in buffer
  25.     INTEGER*4    ILLEGAL        !Position of illegal sequence in buffer
  26.     INTEGER*4    STATE        !Window state retuned by WINENQ
  27.     INTEGER*4    SEGMENT        !Segment number in saved drawing
  28.     REAL*4        SAVEDWINDOW(4)    !Window bounds of saved drawing
  29.     REAL*4        WIDTH        !Desired width
  30.     REAL*4        HEIGHT        !Desired height
  31.     REAL*4        SCALE        !Desired scale factor
  32.     CHARACTER*255    INPUT        !Name of input file
  33.     CHARACTER*255    OUTPUT        !Name of output file
  34.     LOGICAL        FORMFEED    !Do we want a formfeed at the end of the
  35.                     !file?
  36.  
  37.     COMMON/GINOTOSIX/INPUT,OUTPUT,WIDTH,HEIGHT,SCALE,SEGMENT,FORMFEED
  38.  
  39. C    Get the parameters from the command line
  40.      
  41.     CALL CLI
  42.  
  43.     CALL GINO
  44.     
  45. C    First use the dummy driver to find the window size of the saved drawing
  46.  
  47.     CALL DUMMY
  48.  
  49.     OPEN (UNIT=3,
  50.     1   FILE = INPUT,
  51.     1   STATUS = 'OLD',
  52.     1   READONLY)
  53.  
  54.     CALL WINDOW(2)
  55.  
  56.     CALL GETDRA(3,SEGMENT,3,1)
  57.     CALL WINENQ(STATE,1,4,SAVEDWINDOW)
  58.  
  59.     CALL DEVEND
  60.  
  61. C    Now open the LN03 driver and set up the transformations to rotate the
  62. C    picture through 90 degrees and scale it to the user's desired size
  63.  
  64.     IF (HEIGHT.EQ.0.0) HEIGHT = SAVEDWINDOW(4)-SAVEDWINDOW(3)
  65.     IF (WIDTH.EQ.0.0) WIDTH = SAVEDWINDOW(2)-SAVEDWINDOW(1)
  66.     IF (SCALE.EQ.0.0) THEN
  67.         SCALE = WIDTH/(SAVEDWINDOW(2)-SAVEDWINDOW(1))
  68.         SCALE = MIN(SCALE,HEIGHT/(SAVEDWINDOW(4)-SAVEDWINDOW(3)))
  69.     END IF
  70.     
  71.     OPEN (UNIT=1,
  72.     1   FILE = 'GINOTOSIX.TMP',
  73.     1   RECL = 4096,
  74.     1   STATUS  = 'NEW')
  75.  
  76.     OPEN (UNIT=3,
  77.     1   FILE = INPUT,
  78.     1   STATUS = 'OLD',
  79.     1   READONLY)
  80.  
  81.     CALL LN03
  82.  
  83.     CALL LINWID(0.2)
  84.     CALL WINDO2(0.0,HEIGHT,0.0,WIDTH)
  85.     CALL CHASWI(1)
  86.     CALL SCALE2(SCALE,SCALE)
  87.     CALL ROTAT2(90.0)
  88.     CALL SHIFT2(-SAVEDWINDOW(1),-SAVEDWINDOW(4))
  89.     CALL GETPIC(3,SEGMENT)
  90.     CALL DEVEND
  91.  
  92.     CLOSE(3)
  93.  
  94. C    Next, open the sixel file produced by GINO, and prepare to filter it to
  95. C    remove <ESC>c (printer reset), split lines longer than 256 bytes, and
  96. C    remove the FORTRAN carriage controls 
  97.  
  98.     OPEN (UNIT=1,
  99.     1   FILE = 'GINOTOSIX.TMP',
  100.     1   STATUS  = 'OLD',
  101.     1   DISPOSE = 'DELETE')
  102.  
  103.     OPEN (UNIT=2,
  104.     1   FILE = OUTPUT,
  105.     1   ACCESS        = 'SEQUENTIAL',
  106.     1   CARRIAGECONTROL = 'NONE',
  107.     1   FORM        = 'FORMATTED',
  108.     1   RECORDTYPE        = 'VARIABLE',
  109.     1   RECL        = 256,
  110.     1   STATUS        = 'NEW')
  111.     
  112. C    Repeat until end-of-file
  113.  
  114.     DO WHILE (.TRUE.)
  115.     
  116.         READ (1,999,END=500) COUNT,LINE(1:COUNT)
  117.  
  118. C        Remove all occurences of <ESC>c
  119.  
  120.         ILLEGAL = INDEX(LINE(1:COUNT),CHAR(27)//'c')
  121.     
  122.         DO WHILE (ILLEGAL.GT.0)
  123.         IF (ILLEGAL.EQ.COUNT-1) THEN
  124.             IF (COUNT.GT.2) LINE(1:COUNT-2) = LINE(1:ILLEGAL-1)
  125.         ELSE
  126.             LINE(1:COUNT-2) = LINE(1:ILLEGAL-1)//LINE(ILLEGAL+2:COUNT)
  127.         END IF
  128.         COUNT = COUNT-2
  129.         IF (COUNT.GT.2) THEN
  130.             ILLEGAL = INDEX(CHAR(27)//'c',LINE(1:COUNT))
  131.         ELSE
  132.             ILLEGAL = 0
  133.         END IF
  134.         END DO
  135.  
  136. C        Split lines longer than 256 bytes
  137.  
  138.         START=1
  139.  
  140.         DO WHILE (START.LE.COUNT.AND.COUNT.GT.0)
  141.         WRITE(2,998)LINE(START:MIN(START+255,COUNT))
  142.         START = START+256
  143.         END DO
  144.     
  145.     END DO
  146.  
  147. 500    IF (FORMFEED) WRITE(2,997) '0C'X
  148.     
  149. C    Close the files and exit
  150.  
  151.     CLOSE(1)
  152.     CLOSE(2)
  153.  
  154.     CALL GINEND
  155.  
  156. 997    FORMAT(A1)
  157. 998    FORMAT(A)
  158. 999    FORMAT(X,Q,A)
  159.     END
  160.